home *** CD-ROM | disk | FTP | other *** search
/ BMUG PD-ROM A / PD-ROM A.iso / Programming / Programming Languages / Pocket Forth rel.5 / Text files / FloatingPoint < prev    next >
Encoding:
Text File  |  1991-07-21  |  1.7 KB  |  44 lines  |  [TEXT/EDIT]
  1. ( FloatingPoint ) hex
  2. ( a simple implementation of sane stuff )
  3.  
  4. 2variable FPIN  ( integer input variable )
  5. : FLOAT ( compile: --  ) ( run: -- addr ) variable 8 allot ;
  6. : 4PACK ( -- ) ,$ A9EB ; macro ( compile a _Pack4 trap )
  7. : FOP2 ( source dest opword -- ) rot a>r  swap a>r  >r 4pack ;
  8. : F! ( d float -- ) >r here 2! r> here a>r  a>r  280E >r 4pack ;
  9. : F@ ( float -- d ) a>r  here a>r  2810  >r 4pack  here 2@ ;
  10. : F+ ( float1 float2 -- ) 0 fop2 ;  ( f1 + f2 -> f2 )
  11. : F* ( float1 float2 -- ) 4 fop2 ;  ( f1 * f2 -> f2 )
  12. : F- ( float1 float2 -- ) 2 fop2 ;  ( f2 - f1 -> f2 )
  13. : F/ ( float1 float2 -- ) 6 fop2 ;  ( f2 / f1 -> f2 )
  14. : FROOT ( float -- )  a>r 12 >r 4pack ;  ( √f -> f )
  15. : F^2 ( float -- ) dup f* ;  ( f^2 -> f )
  16.  
  17. decimal
  18. 2variable FORM  10 0 form 2!  ( decform record )
  19. : PLACES ( -- n ) form 2+ @ 1- ;  ( number of decimal places )
  20. : F. ( float -- ) ( print float in base 10 scientific notation )
  21.     here 25 0 fill  ( prepare conversion area )
  22.     form a>r  a>r  here a>r  11 >r  4pack  ( convert )
  23.     here @ IF 45 emit THEN  ( print - if negative )
  24.     here 5 + 1 type  ( print first digit )
  25.     8 emit 46 emit  here 6 + places type  ( print decimal part )
  26.     69 emit  here 2+ @  places + . ;  ( print exponent )
  27.  
  28. ( floating point example: use pythagorean theorem )
  29. float S1   ( create a floating point number for side 1 )
  30. float S2   ( create another float for side 2 )
  31.  
  32. : PYTH ( side1 side2 -- ) ( print hypotenuse two ways )
  33.     s>d s2 f!  s>d s1 f!  ( setup s1, s2 floats )
  34.     s1 f^2  s2 f^2  s1 s2 f+  s2 froot  ( calc: √[s1^2+s2^2] )
  35.     s2 f. cr  ( print it in scientific notation )
  36.     s2 f@ d. ;  ( print nearest integer )
  37.  
  38. page
  39. ( Try it out! )
  40.  
  41. 300 400 pyth  ( should be 500 )
  42.  
  43. 286 549 pyth  ( should be 619.029078477 by my HP-48 calc )
  44.